home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Dr. Windows 3
/
dr win3.zip
/
dr win3
/
PROGRAMR
/
MWCC03.ZIP
/
MESSAGE.ZIP
/
MSGUNIT.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1993-08-18
|
27KB
|
855 lines
{**********************************************************************}
{* *}
{* Microworks Sample Application *}
{* *}
{* for Borland Pascal v7.0 and Turbo Pascal for Windows v1.5 *}
{* *}
{* Copyright 1992-93 Jeff Franks (Microworks) Sydney, Australia. *}
{* *}
{* You are free to use, modify, reproduce and distribute the *}
{* Sample Files (and/or any modified version) in any way you *}
{* find useful. *}
{* *}
{**********************************************************************}
{*** Introduction
Unit := MsgUnit
Files := Msgunit.pas
Units Required := MWCC.dll
Tabs := 2
Screen := 800 * 600
Date := August, 1993.
MsgUnit is the complete source code for the MWCC and SFX message boxes. It includes
the drawing, painting and keydown procedures from MWCC.dll (not found in MMsgBox.pas
in RTL.ZIP). I've included this source code as an example of how to write a non-OWL
application should the need arise - like in a DLL.
{*** About the Message Box unit
I rewrote to OWL MWCC and SFX message boxes from the previous version (in the MWCC unit in
MWCC02.ZIP) because I wanted to put the message boxes in MWCC.dll. Initially I rewrote
the message boxes using the DLLAPP.ZIP sample found in the BPascal forum's OWL library
(No 8). It worked great - 90% of the time, but every now and then I got a general
protection fault. The best I could do to trace the fault was to the behind the scenes
TWindowsObject.GetObjectPtr routine for the dummy DLLAPP Window. After weeks of hasle I
decided it would be quicker to rewrite the message boxes without Object Windows. One week
later and everything was working well. Best of all the exe files were about 4-5k smaller.
Then I hit another problem. You can't have multiple instances in a DLL. Because only one
instance of a dll is ever loaded, the second instance of an application that is run from
a DLL overwrites the data for the first instance. When you close the second instance your
left with the first instance and no data. This leaves you with is a window shell that
doesn't know what to do with itself.
I managed to find a multiple instance DLL that uses assembly code to keep a list of tasks.
Each new task that uses the DLL gets its own data segment. Unfortunaltely, it would have
taken too long to rewrite the message boxes a third time so I left that until the next
version.
MsgUnit imports the MWCC.dll procedures and functions it needs itself, so it doesn't need
MObjects.
One advantage of using generic Pascal programming to write a Windows program is that it
produces a smaller exe file.
When reading through the code everything is more or less upside down compared to an OWL
program because functions and procedures must be declared before they can be used. you might
find it easier to start at the bottom - at the MsgBoxWinMain procedure.
The code might look a little more complicated (or messy) because it is used to display two
different types of message boxes.
To use this unit compile it and then compile and run the Msgtest program.
I hope you find this unit useful.
Jeff...
***}
unit MsgUnit;
interface
uses WinProcs, WinTypes;
type
TMinMaxInfo = array [0..4] of TPoint;
PMinMaxInfo = ^TMinMaxInfo;
function MWCCMsgBox (WndParent: HWnd; ATxt, ACaption: PChar; ATextType: Word;
ABmp: PChar): Integer;
function SFXMsgBox (WndParent: HWnd; ATxt, ACaption: PChar; ATextType: Word): Integer;
function CreateDefaultFont (IsBold: Boolean): HFont;
procedure Draw3DBorder (Wnd: HWnd; X, Y, W, H: Integer; Shade: Word);
procedure DrawSFXFrame (Wnd: HWnd);
implementation
const
ctl_Recessed = 51;
ctl_Raised = 52;
var
Default1 : Boolean;
Default2 : Boolean;
Default3 : Boolean;
SFXStyle : Boolean;
BkBmp : HBitmap;
MsgBmp : HBitmap;
UpBmp1 : HBitmap;
UpBmp2 : HBitmap;
UpBmp3 : HBitmap;
BkBrush : HBrush;
LastWnd : HWnd;
MsgBoxWnd : HWnd;
WndButton1 : HWnd;
WndButton2 : HWnd;
WndButton3 : HWnd;
ID1 : Integer;
ID2 : Integer;
ID3 : Integer;
a : Integer;
b : Integer;
c : Integer;
d : Integer;
e : Integer;
f : Integer;
Reply : Integer;
ButtonProc1 : TFarProc;
ButtonProc2 : TFarProc;
ButtonProc3 : TFarProc;
OldProc1 : TFarProc;
OldProc2 : TFarProc;
OldProc3 : TFarProc;
HLib : THandle;
MWCCWndHdl : THandle;
SFXWndHdl : THandle;
WinRect : TRect;
TextType : Word;
szText : array[0..255] of Char;
szTitle : array[0..50] of Char;
function CreateDefaultFont; external 'MWCC' Index 1;
procedure Draw3DBorder; external 'MWCC' Index 5;
procedure DrawSFXFrame; external 'MWCC' Index 10;
procedure DrawMsgBoxButton (Wnd: HWnd; lParam: LongInt);
{*** From MWCC.dll
Draws the Message box buttons. It's a bit slow when launching the message box
because it loads each bitmap as it needs it. To overcome this the bitmaps that
need to be displayed initially (the up bitmaps) are loaded before the window is
constructed.
***}
var
Down : Boolean;
Up : Boolean;
Other : Boolean;
Bitmap : HBitmap;
MemDC : HDC;
Offset : Integer;
OldObject : THandle;
begin
with pDrawItemStruct(lParam)^, rcItem do
case CtlType of
odt_Button:
begin
if ItemAction = oda_Focus then exit;
Down := ((ItemAction and oda_Select) > 0) and ((ItemState and ods_Selected) > 0);
Up := ((ItemAction and oda_Select) > 0) and ((ItemState and ods_Selected) = 0);
Other := ((ItemAction and oda_Select) = 0) and ((ItemState and ods_Selected) = 0);
FillRect(HDC, rcItem, GetStockObject(LtGray_Brush));
Draw3DBorder(HWndItem, Left, Top, Right-Left, Bottom-Top, ctl_Recessed);
MemDC := CreateCompatibleDC(HDC);
if (GetFocus = HWndItem) then
begin
if Down then
OffSet := 3000
else
OffSet := 5000;
end
else
begin
if Down then
OffSet := 3000
else
if Up then
OffSet := 5000
else
if Other then
OffSet := 1000;
end;
Bitmap := LoadBitmap(HLib, PChar(OffSet + CtlID));
OldObject := SelectObject(MemDC, Bitmap);
BitBlt(HDC, Left, Top, Right-Left, Bottom-Top, MemDC, 0, 0, SrcCopy);
SelectObject(MemDC, OldObject);
DeleteObject(Bitmap);
DeleteDC(MemDC);
end;
end;
end;
procedure MsgBoxKeyDown (ParentWnd, Wnd: HWnd; wParam: Word);
{*** From MWCC.dll
MsgBoxKeyDown handles tabbing through the buttons. Because the message box is a window
and not a dialog tabbing doesn't automatically occur. EnableKBHandler can't be used here
because this is a non_OWL program.
***}
var
SibWnd : HWnd;
lStyle : LongInt;
ID : Word;
begin
SibWnd := 0;
ID := GetDlgCtrlID(Wnd);
case wParam of
vk_Return :
begin
SendMessage(MsgBoxWnd, wm_Command, ID, ID + bn_Clicked);
Exit;
end;
end;
while SibWnd = 0 do
begin
if ID = 7 then
ID := 1
else
ID := ID + 1;
SibWnd := GetDlgItem(MsgBoxWnd, ID);
lStyle := GetWindowLong (SibWnd, gwl_Style);
if not (lStyle = lStyle or ws_TabStop) then
SibWnd := 0;
end;
case wParam of
vk_Tab:
begin
SetFocus(SibWnd);
InvalidateRect(Wnd, nil, True);
InvalidateRect(SibWnd, nil, True);
end;
end;
end;
procedure PaintMsgBox (Wnd: HWnd; AText: PChar; Ofs1, Ofs2, Ofs3: Integer;
MsgBmp: HBitmap; SFXStyle: Boolean);
{*** From MWCC.dll
PaintMsgBox handles all t